perm filename ROADED.SAI[1,BGB] blob
sn#001261 filedate 1972-10-22 generic text, type T, neo UTF8
00100 BEGIN "ROADED"
00200 DEFINE α="COMMENT",∂="DATUM";
00300 α WORLD MODEL DATA;
00400 EXTERNAL REAL ARRAY LOCII[0:400,1:3];
00500 EXTERNAL INTEGER ARRAY ARCS[1:300,1:3];
00600 EXTERNAL INTEGER ARRAY SEGS[1:300,1:2];
00700 α LEAP DECLARATIONS;
00800 REQUIRE 100 NEW_ITEMS;
00900 REQUIRE 100 PNAMES;
01000 ITEM NIL;
01100 α EXTERNAL COMMAND PROCEDURES;
01200 EXTERNAL PROCEDURE FLYCAM;
01300 α TTY COMMAND SCANNER DATA;
01400 STRING WORD,LINE,SUBR,ARGS;
01500 INTEGER CHR,BRKCHR,I,N;
01600 REAL ARG;
01700 BREAKSET(1,"()[]←","I");
01800 α MAIN LISTEN LOOP;
01900 WHILE TRUE DO
02000 BEGIN
02100 LABEL EOL;
02200 OUTSTR("*");
02300 LINE ← INCHWL;
02400 IF LENGTH(LINE)=0 THEN GO EOL;
02500
02600 IF EQU(LINE,"FLYCAM") THEN BEGIN FLYCAM;GO EOL END;
00100 ARGS ← LINE;
00200 SUBR ← SCAN(ARGS,1,BRKCHR);
00300 IF BRKCHR="(" THEN
00400 BEGIN "SUBRS"
00500
00600 IF EQU(SUBR,"CURLY") THEN
00700 BEGIN "CURLY"
00800 INTEGER ARRAY ITEMVAR IT;
00900 INTEGER FLG,I,IMAX;
01000 WORD ← SCAN(ARGS,1,BRKCHR);
01100 IT ← CVSI(WORD,FLG);
01200 IF FLG THEN GO EOL;
01300 IMAX ← ARRINFO(∂(IT),0);
01400 OUTCHR("(");
01500 FOR I←1 STEP 1 UNTIL IMAX DO
01600 BEGIN
01700 OUTSTR(CVS(∂(IT)[I]));
01800 IF I=IMAX THEN OUTSTR(")"&13&10) ELSE OUTCHR(",");
01900 END; GO EOL;
02000 END "CURLY";
00100 IF EQU(SUBR,"SETQ") THEN
00200 BEGIN "SETQ"
00300 INTEGER ARRAY CURLGON[1:50];
00400 INTEGER ARRAY ITEMVAR IT;
00500 INTEGER FLG,I,IMAX;
00600 WORD ← SCAN(ARGS,1,BRKCHR);
00700 I ← 0;
00800 DO CURLGON[I←I+1] ← INTSCAN(ARGS,BRKCHR) UNTIL BRKCHR=")";
00900 IT ← CVSI(WORD,FLG);
01000 IF ¬FLG ∧ I=ARRINFO(∂(IT),0) THEN ARRBLT(∂(IT)[1],CURLGON[1],I) ELSE
01100 BEGIN
01200 INTEGER ARRAY NEWCURL[1:I];
01300 ARRBLT(NEWCURL[1],CURLGON[1],I);
01400 IF ¬FLG THEN
01500 BEGIN
01600 DEL_PNAME(IT);
01700 DELETE(IT);
01800 END;
01900 IT ← NEW(NEWCURL);
02000 NEW_PNAME(IT,WORD);
02100 END;
02150 OUTSTR(9&WORD&13&10);
02200 GO EOL;
02300 END "SETQ";
02400
02500 END "SUBRS";
00100 BEGIN "EXPRS"
00200 CHR ← LOP(LINE);
00300 α VERTEX EXAMINE AND DEPOSIT;
00400 IF CHR="V" THEN
00500 BEGIN
00600 N ← INTSCAN(LINE,BRKCHR);
00700 IF BRKCHR THEN
00800 IF BRKCHR="[" THEN
00900 BEGIN
01000 I ← INTSCAN(LINE,BRKCHR);
01100 CHR ← LOP(LINE);
01200 CHR ← LOP(LINE);
01300 LOCII[N,I]← REALSCAN(LINE,BRKCHR);
01400 END ELSE
01500 BEGIN
01600 LOCII[N,1]← REALSCAN(LINE,BRKCHR);
01700 LOCII[N,2]← REALSCAN(LINE,BRKCHR);
01800 LOCII[N,3]← REALSCAN(LINE,BRKCHR);
01900 END;
02000 OUTSTR(9&CVG(LOCII[N,1]));
02100 OUTSTR(9&CVG(LOCII[N,2]));
02200 OUTSTR(9&CVG(LOCII[N,3]));
02300 OUTSTR(13&10);
02400 GO EOL;
02500 END;
00100 α SEGMENT EXAMINE AND DEPOSIT;
00200 IF CHR="S" THEN
00300 BEGIN
00400 N ← INTSCAN(LINE,BRKCHR);
00500 IF BRKCHR THEN
00600 IF BRKCHR="[" THEN
00700 BEGIN
00800 I ← INTSCAN(LINE,BRKCHR);
00900 CHR ← LOP(LINE);
01000 CHR ← LOP(LINE);
01100 SEGS[N,I]← INTSCAN(LINE,BRKCHR);
01200 END ELSE
01300 BEGIN
01400 SEGS[N,1]← INTSCAN(LINE,BRKCHR);
01500 SEGS[N,2]← INTSCAN(LINE,BRKCHR);
01600 END;
01700 OUTSTR(9&CVS(SEGS[N,1]));
01800 OUTSTR(9&CVS(SEGS[N,2]));
01900 OUTSTR(13&10);
02000 GO EOL;
02100 END;
02200
02300 α ARC EXAMINE AND DEPOSIT;
02400 IF CHR="A" THEN
02500 BEGIN
02600 N ← INTSCAN(LINE,BRKCHR);
02700 IF BRKCHR THEN
02800 IF BRKCHR="[" THEN
02900 BEGIN
03000 I ← INTSCAN(LINE,BRKCHR);
03100 CHR ← LOP(LINE);
03200 CHR ← LOP(LINE);
03300 ARCS[N,I]← INTSCAN(LINE,BRKCHR);
03400 END ELSE
03500 BEGIN
03600 ARCS[N,1]← INTSCAN(LINE,BRKCHR);
03700 ARCS[N,2]← INTSCAN(LINE,BRKCHR);
03800 ARCS[N,3]← INTSCAN(LINE,BRKCHR);
03900 END;
04000 OUTSTR(9&CVS(ARCS[N,1]));
04100 OUTSTR(9&CVS(ARCS[N,2]));
04200 OUTSTR(9&CVS(ARCS[N,3]));
04300 OUTSTR(13&10);
04400 GO EOL;
04500 END;
00100 END "EXPRS";
00200 EOL:
00300 END;
00400 END